home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
bcc101.zip
/
DIALOG.ZIP
/
DIALOG.BAS
next >
Wrap
BASIC Source File
|
1993-04-06
|
9KB
|
209 lines
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' dialog.bas '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' compile -> bc dialog /o; '
' link -> link /e YourProg + dialog, , nul, qb; '
' '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'$INCLUDE: 'DIALOG.BI'
'$INCLUDE: 'QB.BI'
SUB BoxDialog (Top%, BoxWidth%, Border$, Msg$, MsgClr%, Shadow%)
Temp$ = SPACE$(BoxWidth) ' make a temp string
BoxTop = ASC(MID$(Border$, 2, 1)) ' value of top character
BoxBot = ASC(MID$(Border$, 7, 1)) ' value of bottom char
IF MonCols = 0 THEN VidInfo ' obtain video segment and screen dimensions
col = 1 + ((MonCols - BoxWidth) \ 2) ' get left-hand column
IF col > 1 THEN col = col + (BoxWidth MOD 2) ' make em visually line up
row = Top ' set starting row
MID$(Temp$, 1, 1) = MID$(Border$, 1, 1) ' set upper-left corner
MID$(Temp$, 2) = STRING$(BoxWidth - 1, BoxTop) ' set top of box
MID$(Temp$, BoxWidth, 1) = MID$(Border$, 3, 1) ' set upper-right corner
WriteStr Temp$, row, col, MsgClr ' write this string
row = row + 1 ' increment row position
IF LEN(Msg$) < BoxWidth - 4 THEN ' Msg$ will fit in one line
LSET Temp$ = "" ' clear the temp string
MID$(Temp$, 1, 1) = MID$(Border$, 4, 1) ' set left-side character
MID$(Temp$, 3) = Msg$ ' set message into temp string
MID$(Temp$, BoxWidth, 1) = MID$(Border$, 5, 1) ' set right-side char
WriteStr Temp$, row, col, MsgClr ' send temp string to screen
IF Shadow THEN GOSUB ShadowRight ' shadow as called for
ELSE ' Msg$ needs to be word wrapped
begin = 0: endpos = BoxWidth - 4 ' set begin and end of area
WrapIt:
Char = ASC(MID$(Msg$, endpos, 1)) ' get one char from message
LSET Temp$ = "" ' clear temp string
IF Char <> 32 THEN ' if char not a space...
SELECT CASE Char
' do nothing if this character is one of these-> ",-.:;"
CASE 44, 45, 46, 58, 59 ' do nothing
CASE ELSE
IF endpos < LEN(Msg$) THEN ' if not at message end...
endpos = endpos - 1 ' decrement endpos
GOTO WrapIt ' do it all over again
END IF
END SELECT
END IF
tempLen = endpos - begin ' calc length of line to display
MID$(Temp$, 1, 1) = MID$(Border$, 4, 1) ' set left-side character
MID$(Temp$, 3) = MID$(Msg$, begin + 1, tempLen) ' set portion of msg
tempLen = tempLen + 1 ' increment tempLen variable
MID$(Temp$, BoxWidth, 1) = MID$(Border$, 5, 1) ' set right-side char
WriteStr Temp$, row, col, MsgClr ' send temp string to screen
IF Shadow THEN GOSUB ShadowRight ' shadow as called for
IF begin + tempLen < LEN(Msg$) THEN ' haven't processed all of Msg
row = row + 1 ' increment row position
begin = endpos ' set new beginning position
endpos = begin + BoxWidth - 4 ' set new ending position
IF endpos > LEN(Msg$) THEN endpos = LEN(Msg$) ' oops - to far
GOTO WrapIt ' do it all over again
END IF
END IF
row = row + 1 ' increment row position
MID$(Temp$, 1, 1) = MID$(Border$, 6, 1) ' set lower-left corner
MID$(Temp$, 2) = STRING$(BoxWidth - 2, BoxBot) ' set bottom of box
MID$(Temp$, BoxWidth, 1) = MID$(Border$, 8, 1) ' set lower-right corner
WriteStr Temp$, row, col, MsgClr ' send temp string to screen
IF Shadow THEN GOSUB ShadowRight ' shadow as called for
row = row + 1 ' increment row position
IF Shadow THEN ' shadow the line below the box
FOR begin = col + 2 TO col + BoxWidth + 1
IF begin <= MonCols THEN DoShadow row, begin
NEXT
END IF
EXIT SUB
ShadowRight:
IF col + BoxWidth <= MonCols THEN DoShadow row, col + BoxWidth
IF col + BoxWidth + 1 <= MonCols THEN DoShadow row, col + BoxWidth + 1
RETURN
END SUB
FUNCTION ClrAttr% (fg%, bg%) STATIC
' (fg AND 15) removes blink from forground color
' OR (16 * bg ...) adds background color to attribute
' - (128 * (fg > 15)) adds blink {if any} to high bits of attribute byte
ClrAttr% = (fg AND 15) OR (16 * bg - (128 * (fg > 15)))
END FUNCTION
SUB DoShadow (row%, col%) STATIC
IF VidSeg = 0 THEN VidInfo ' obtain video segment and screen dimensions
offset = MonCols * 2 * (row - 1) + col * 2 - 1 ' get video map coordinates
DEF SEG = VidSeg ' video map segment
attr = PEEK(offset) AND 15 ' get attrib and remove BG color
attr = attr + (8 * (attr > 7)) ' remove high intensity
POKE offset, attr ' put new color at screen location
DEF SEG ' back to BASIC DGROUP
END SUB
SUB VidInfo
DIM Reg AS RegType
Reg.ax = &HF00 ' get current display mode
INTERRUPT &H10, Reg, Reg ' BIOS video interrupt 10h
Vmode = Reg.ax MOD 256 ' video mode returned in AL
VidSeg = &HB800 ' assume CGA color segment
SELECT CASE Vmode
CASE 0 - 3, 7
'case 0: ' 40x25 B&W text screen
'case 1: ' 40x25 color text screen
'case 2: ' 80x25 B&W text scren
'case 3: ' 80x25 color text scren
'case 7: ' mono adapter or EGA text screen
IF Vmode = 7 THEN VidSeg = &HB000 ' fix segment if mono
CASE 4 - 6
'case 4: ' CGA 320x200 4-color graphics
'case 5: ' CGA 320x200 4-color (clr burst off)
'case 6: ' CGA 640x200 2-color graphics
CASE 8
'case 8: ' Hercules graphics or low res PCjr
VidSeg = &HB000 ' seg for Herc - PCjr = ??
CASE 9 - 10
'case 9: ' 320x200 16-color PCjr (seg = ??)
'case 10: ' 640x200 4-color PCjr (seg = ??)
CASE 13 - 19
'case 13: ' EGA 320x200 16-color graphics
'case 14: ' EGA 640x200 16-color graphics
'case 15: ' EGA 640x350 monochrome graphics
'case 16: ' EGA 640x350 4 or 16 clr(RAM decides)
'case 17: ' VGA 640x480 2-color graphics
'case 18: ' VGA 640x480 16-color graphics
'case 19: ' VGA 320x200 256-color graphics
VidSeg = &HA000
CASE ELSE
'default: ' unknown/unsupported mode?
END SELECT
DEF SEG = 0 ' ROM BIOS
MonCols = PEEK(&H44A) ' get number of display columns
MonRows = PEEK(&H484) + 1 ' get number of display rows
DEF SEG ' back to BASIC DGROUP
END SUB
SUB WriteStr (A$, row%, col%, attr%) STATIC
IF VidSeg = 0 THEN VidInfo ' obtain video segment and screen dimensions
offset = MonCols * 2 * (row - 1) + col * 2 - 2 ' get video map coordinates
Saddr = VARSEG(A$) ' segment to string's location
Z = VARPTR(A$) ' have QB give you string's descripter
'---- Address is byte two and three of descripter (past length
' word, bytes 0 and 1).
Soffset& = PEEK(Z + 2) + 256& * PEEK(Z + 3) ' get string's address
FOR CharCount = 1 TO LEN(A$) ' roll through the string
DEF SEG = Saddr ' set segment at string's location
Char = PEEK(Soffset&) ' get one char from string
Soffset& = Soffset& + 1 ' increment pointer into string
DEF SEG = VidSeg ' video map segment
POKE offset, Char ' poke the character into map
offset = offset + 1 ' increment video map position
POKE offset, attr ' poke the attribute into map
offset = offset + 1 ' increment video map position
NEXT
DEF SEG ' back to BASIC DGROUP
END SUB